home *** CD-ROM | disk | FTP | other *** search
/ SGI Freeware 1999 August / SGI Freeware 1999 August.iso / dist / fw_xemacs.idb / usr / freeware / lib / xemacs-20.4 / lisp / calendar / appt.el.z / appt.el
Encoding:
Text File  |  1998-05-21  |  28.4 KB  |  745 lines

  1. ;;; appt.el --- appointment notification functions.
  2. ;; Keywords: calendar
  3.  
  4. ;;; -*- Mode:Emacs-Lisp -*-
  5. ;; Appointment notification functions.
  6. ;; Copyright (C) 1989, 1990, 1992, 1993, 1994 Free Software Foundation, Inc.
  7.  
  8. ;; This file is part of XEmacs.
  9.  
  10. ;; XEmacs is free software; you can redistribute it and/or modify it
  11. ;; under the terms of the GNU General Public License as published by
  12. ;; the Free Software Foundation; either version 2, or (at your option)
  13. ;; any later version.
  14.  
  15. ;; XEmacs is distributed in the hope that it will be useful, but
  16. ;; WITHOUT ANY WARRANTY; without even the implied warranty of
  17. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  18. ;; General Public License for more details.
  19.  
  20. ;; You should have received a copy of the GNU General Public License
  21. ;; along with XEmacs; see the file COPYING.  If not, write to the Free
  22. ;; Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
  23.  
  24. ;;; 29-nov-89    created by Neil Mager <neilm@juliet.ll.mit.edu>.
  25. ;;; 23-feb-91    hacked upon by Jamie Zawinski <jwz@lucid.com>.
  26. ;;;  1-apr-91    some more.
  27. ;;; 12-jul-95   updated for XEmacs 19.12 by Greg Veres 
  28. ;;;             <gveres@cgl.uwaterloo.ca>
  29. ;;; 21-mar-97   better support for fancy diary display by Tomasz J. Cholewo 
  30. ;;;             <t.cholewo@ieee.org>
  31. ;;;
  32. ;; appt.el - visible and/or audible notification of
  33. ;;           appointments from ~/diary file generated from
  34. ;;           Edward M. Reingold's calendar.el.
  35. ;;
  36. ;; Version 2.1
  37. ;;
  38. ;; Comments, corrections, and improvements should be sent to
  39. ;; Neil M. Mager
  40. ;; Net                     <neilm@juliet.ll.mit.edu>
  41. ;; Voice                   (617) 981-4803
  42. ;;;
  43. ;;; Thanks to  Edward M. Reingold for much help and many suggestions, 
  44. ;;; And to many others for bug fixes and suggestions.
  45. ;;;
  46. ;;;
  47. ;;; This functions in this file will alert the user of a 
  48. ;;; pending appointment based on their diary file.
  49. ;;;
  50. ;;; ******* It is necessary to invoke 'display-time' and ********
  51. ;;; ******* 'appt-initialize' for this to work properly. ********
  52. ;;; 
  53. ;;; A message will be displayed in the mode line of the emacs buffer and (if
  54. ;;; the user desires) the terminal will beep and display a message from the
  55. ;;; diary in the mini-buffer, or the user may select to have a message
  56. ;;; displayed in a new buffer.
  57. ;;;
  58. ;;; Variables of note:
  59. ;;;
  60. ;;; appt-issue-message        If this variable is nil, then the code in this
  61. ;;;                file does nothing.
  62. ;;; appt-msg-countdown-list    Specifies how much warning you want before 
  63. ;;;                appointments.
  64. ;;; appt-audible        Whether to beep when it's notification-time.
  65. ;;; appt-display-mode-line    Whether to display a countdown to the next 
  66. ;;;                appointment in the mode-line.
  67. ;;; appt-announce-method    The function used to do the notifications.
  68. ;;;    'appt-window-announce           do it in a pop-up window.
  69. ;;;     'appt-frame-announce           do it in a pop-up frame (v19 only)
  70. ;;;    'appt-message-announce           do it in the echo area.
  71. ;;;    'appt-persistent-message-announce  do it in the echo area, but make the
  72. ;;;                    messages not go away at the next keystroke.
  73. ;;; appt-display-duration    If appt-announce-method is set to the function
  74. ;;;                'appt-window-announce, this specifies how many
  75. ;;;                seconds the pop-up window should stick around.
  76. ;;;
  77. ;;; In order to use this, create a diary file, and add the following to your
  78. ;;; .emacs file:
  79. ;;;
  80. ;;;    (require 'appt)
  81. ;;;    (display-time)
  82. ;;;    (appt-initialize)
  83. ;;;
  84. ;;; If you wish to see a list of appointments, or a full calendar, when emacs
  85. ;;; starts up, you can add a call to (diary) or (calendar) after this.
  86. ;;;
  87. ;;;  This is an example of what can be in your diary file:
  88. ;;;     Monday
  89. ;;;       9:30am Coffee break
  90. ;;;      12:00pm Lunch
  91. ;;; 
  92. ;;; Based upon the above lines in your .emacs and diary files, the calendar
  93. ;;; and/or diary will be displayed when you enter emacs and your appointments
  94. ;;; list will automatically be created.  You will then be reminded at 9:20am
  95. ;;; about your coffee break and at 11:50am to go to lunch.
  96. ;;;
  97. ;;; In order to interactively add or delete items from today's list, use 
  98. ;;; Meta-x appt-add and Meta-x appt-delete.  (This does not modify your 
  99. ;;; diary file, so these will be forgotten when you exit emacs.)
  100. ;;;
  101. ;;; Additionally, the appointments list is recreated automatically at 12:01am 
  102. ;;; for those who do not logout every day or are programming late.
  103. ;;;
  104. ;;; You can have special appointments which execute arbitrary code rather than
  105. ;;; simply notifying you -- sort of like the unix "cron" facility.  The syntax
  106. ;;; for this is borrowed from the Calendar's special-date format.  If you have
  107. ;;; a diary entry like
  108. ;;;
  109. ;;;  Monday
  110. ;;;    3:00am    %%(save-all-modified-buffers)
  111. ;;;
  112. ;;; then on monday at 3AM, the function `save-all-modified-buffers' will be
  113. ;;; invoked.  (Presumably this function is defined in your .emacs file.)
  114. ;;; There will be no notification that these "special" appointments are being
  115. ;;; triggered, unless the form evaluated produces a notification.
  116. ;;;
  117. ;;; It is necessary for the entire list after the "%%" to be on one line in 
  118. ;;; your .diary file -- there may not be embedded newlines in it.  This is a
  119. ;;; bit of a misfeature.
  120. ;;;
  121. ;;; This also interacts correctly with Benjamin Pierce's reportmail.el package.
  122. ;;;
  123. ;;; Brief internal description - Skip this if you are not interested!
  124. ;;;
  125. ;;; The function appt-initialize invokes 'diary' to get a list of today's
  126. ;;; appointments, and parses the lines beginning with date descriptions.
  127. ;;; This list is cached away.  'diary' is invoked in such a way so as to
  128. ;;; not pop up a window displaying the diary buffer.
  129. ;;;
  130. ;;; The function appt-check is run from the 'loadst' process (or the 'wakeup'
  131. ;;; process in emacs 18.57 or newer) which is started by invoking display-time.
  132. ;;; It checks this cached list, and announces as appropriate.  At midnight,
  133. ;;; appt-initialize is called again to rebuild this list.
  134. ;;;
  135. ;;; display-time-filter is modified to invoke appt-check.
  136. ;;;
  137. ;;; TO DO:
  138. ;;;
  139. ;;;  o  multiple adjacent appointments are not handled gracefully.  If there 
  140. ;;;     is an appointment at 3:30 and another at 3:35, and you have set things
  141. ;;;     up so that you get a notification twenty minutes before each appt,
  142. ;;;     then a notification should come at 3:10 for the first appt, and at
  143. ;;;     3:15 for the second.  Currently, no notifications are generated for an
  144. ;;;     appointment until all preceding appointments have completely expired.
  145. ;;;
  146. ;;;  o  If there are two appointments at the same time, all but the first are
  147. ;;;     ignored (not announced.)
  148. ;;;
  149. ;;;  o  Appointments which are early enough in the morning that their 
  150. ;;;     announcements should begin before midnight are not announced until
  151. ;;;     midnight.
  152. ;;;
  153. ;;;  o  There should be some way to mark certain appointments as "important,"
  154. ;;;     so that you will be harassed about them even after they have expired.
  155.  
  156.  
  157. (require 'calendar)
  158. (require 'diary-lib)
  159.  
  160. (defcustom appt-issue-message t
  161.   "*If T, the diary buffer is checked for appointments.  For an
  162.  appointment warning to be made, the time must be the first thing on
  163.  the line."
  164.   :type 'boolean
  165.   :group 'appt)
  166.  
  167. (defcustom appt-msg-countdown-list '(20 15 10 5 3 1)
  168.   "*A list of the intervals in minutes before the appointment when
  169.  the warnings will be given.  That is, if this were the list '(5 3 1),
  170.  then a notification would be given five minutes, three minutes, and
  171.  one minute before the appointment."
  172.   :type '(repeat integer)
  173.   :group 'appt)
  174.  
  175. (defcustom appt-check-time-syntax nil
  176.   "*Whether all diary entries are intended to beging with time specifications.
  177. Appt will beep and issue a warning message when encountering unparsable 
  178. lines."
  179.   :type 'boolean
  180.   :group 'appt)
  181.  
  182. (defcustom appt-audible t
  183.   "*Controls whether appointment announcements should beep.
  184. Appt uses two sound-types for beeps: `appt' and `appt-final'.
  185. If this is a number, then that many beeps will occur.
  186. If this is a cons, the car is how many beeps, and the cdr is the
  187.   delay between them (a float, fraction of a second to sleep.)
  188. See also the variable `appt-msg-countdown-list'"
  189.   :type 'boolean
  190.   :group 'appt)
  191.  
  192. (defcustom appt-display-mode-line t
  193.   "*Controls if minutes-to-appointment should be displayed on the mode line."
  194.   :type 'boolean
  195.   :group 'appt)
  196.  
  197. (defcustom appt-announce-method 'appt-window-announce
  198.   "*The name of the function used to notify the user of an impending 
  199. appointment.  This is called with two arguments, the number of minutes
  200. until the appointment, and the appointment description list.
  201.  
  202. Reasonable values for this variable are 'appt-window-announce,
  203. 'appt-message-announce, or 'appt-persistent-message-announce."
  204.   :type 'function
  205.   :group 'appt)
  206.  
  207.  
  208. (defvar appt-time-msg-list nil
  209.   "The list of appointments for today.  Use appt-add and appt-delete
  210.  to add and delete appointments from list.  The original list is generated
  211.  from the today's diary-entries-list. The number before each time/message
  212.  is the time in minutes after midnight.")
  213.  
  214. (defconst max-time 1439
  215.   "11:59pm in minutes - number of minutes in a day minus 1.")
  216.  
  217. (defconst appt-check-tick -1)
  218.  
  219. (defvar appt-disp-frame nil
  220.   "If non-nil, frame to display appointments in.")
  221. (defvaralias 'appt-disp-screen 'appt-disp-frame)
  222.   
  223.  
  224. ;;; Announcement methods
  225.  
  226. (defun appt-message-announce (min-to-app appt)
  227.   "Set appt-announce-method to the name of this function to cause appointment
  228. notifications to be given via messages in the minibuffer."
  229.   (message (if (eq min-to-app 0) "App't NOW."
  230.            (format "App't in %d minute%s -- %s"
  231.                min-to-app
  232.                (if (eq 1 min-to-app) "" "s")
  233.                (car (cdr appt))))))
  234.  
  235.  
  236. (defun appt-persistent-message-announce (min-to-app appt)
  237.   "Set appt-announce-method to the name of this function to cause appointment
  238. notifications to be given via messages in the minibuffer, but have those 
  239. messages stay around even if you type something (unlike normal messages)."
  240.   (let ((str (if (eq min-to-app 0)
  241.          (format "App't NOW -- %s" (car (cdr appt)))
  242.          (format "App't in %d minute%s -- %s"
  243.              min-to-app
  244.              (if (eq 1 min-to-app) "" "s")
  245.              (car (cdr appt)))))
  246.     (in-echo-area-already (eq (selected-window) (minibuffer-window))))
  247.     (if (not in-echo-area-already)
  248.     ;; don't stomp the echo-area-buffer if reading from the minibuffer now.
  249.     (save-excursion
  250.       (save-window-excursion
  251.         (select-window (minibuffer-window))
  252.         (delete-region (point-min) (point-max))
  253.         (insert str))))
  254.     ;; if we're reading from the echo-area, and all we were going to do is
  255.     ;; clear the thing, like, don't bother, that's annoying.
  256.     (if (and in-echo-area-already (string= "" str))
  257.     nil
  258.       (message "%s" str))
  259.     ))
  260.  
  261.  
  262. (defcustom appt-display-duration 5
  263.   "*The number of seconds an appointment message is displayed in its own 
  264.  window if appt-announce-method is 'appt-window-announce."
  265.   :type 'integer
  266.   :group 'appt)
  267.  
  268. (defun appt-window-announce (min-to-app appt)
  269.   "Set appt-announce-method to the name of this function to cause appointment 
  270. notifications to be given via messages in a pop-up window.  The variable
  271. appt-display-duration controls how long this window should be left up."
  272.   (require 'electric)
  273.   (save-excursion
  274.    (save-window-excursion
  275.     ;; Make sure we're not in the minibuffer
  276.     ;; before splitting the window.
  277.      (if (window-minibuffer-p (selected-window))
  278.      nil
  279.        (select-window (frame-lowest-window))
  280.        (split-window))
  281.     (let (appt-disp-buf)
  282.       (unwind-protect
  283.        (progn
  284.          (setq appt-disp-buf (set-buffer (get-buffer-create "*appt-buf*")))
  285.          ;; set the mode-line of the pop-up window
  286.          (setq modeline-format 
  287.            (concat "-------------------- Appointment "
  288.          (if (eq min-to-app 0)
  289.              "NOW"
  290.            (concat "in " min-to-app
  291.              (if (eq min-to-app 1) " minute" " minutes")))
  292.          ". ("
  293.          (let ((h (string-to-int
  294.                 (substring (current-time-string) 11 13))))
  295.            (concat (if (> h 12) (- h 12) h) ":"
  296.                (substring (current-time-string) 14 16)
  297.                (if (< h 12) "am" "pm")))
  298.          ") %-"))
  299.          (pop-to-buffer appt-disp-buf)
  300.          (insert (car (cdr appt)))
  301.          (shrink-window-if-larger-than-buffer
  302.            (get-buffer-window appt-disp-buf))
  303.          (set-buffer-modified-p nil)
  304.          (sit-for appt-display-duration))
  305.     (and appt-disp-buf (kill-buffer appt-disp-buf)))))))
  306.  
  307. (defvar appt-frame-defaults nil)
  308. (defvaralias 'appt-screen-defaults 'appt-frame-defaults)
  309.  
  310. (defun appt-frame-announce (min-to-app appt)
  311.   "Set appt-announce-method to the name of this function to cause appointment 
  312. notifications to be given via messages in a pop-up frame."
  313.   (let ()
  314.     (save-excursion
  315.       (set-buffer (get-buffer-create "*appt-buf*"))
  316.       (erase-buffer)
  317.       ;; set the mode-line of the pop-up window
  318.       (setq modeline-format 
  319.         (concat "-------------------- Appointment "
  320.             (if (eq min-to-app 0)
  321.             "NOW"
  322.               (concat "in " min-to-app
  323.                   (if (eq min-to-app 1) " minute" " minutes")))
  324.             ". ("
  325.             (let ((h (string-to-int
  326.                   (substring (current-time-string) 11 13))))
  327.               (concat (if (> h 12) (- h 12) h) ":"
  328.                   (substring (current-time-string) 14 16)
  329.                   (if (< h 12) "am" "pm")))
  330.             ") %-"))
  331.       (insert (car (cdr appt)))
  332.       (let ((height (max 10 (min 20 (+ 2 (count-lines (point-min)
  333.                               (point-max)))))))
  334.         ;; If we already have a frame constructed, use it. If not, or it has
  335.         ;; been deleted, then make a new one
  336.     (if (and appt-disp-frame (frame-live-p appt-disp-frame))
  337.         (let ((s (selected-frame)))
  338.           (select-frame appt-disp-frame)
  339.           (make-frame-visible appt-disp-frame)
  340.           (set-frame-height appt-disp-frame height)
  341.           (sit-for 0)
  342.           (select-frame s))
  343.           (progn
  344.             (setq appt-disp-frame (make-frame))
  345.             (set-frame-height appt-disp-frame height)
  346.             )
  347.           )
  348.         )
  349.       )
  350.     )
  351.   )
  352. (defalias 'appt-screen-announce 'appt-frame-announce)
  353.  
  354. ;;; To display stuff in the mode line, we use a new variable instead of
  355. ;;; just adding stuff to the display-time-string -- this causes less
  356. ;;; flicker.
  357.  
  358. (defcustom appt-mode-line-string ""
  359.   "*The string displayed in the mode line by the appointment package."
  360.   :type 'string
  361.   :group 'appt)
  362.  
  363. (defun appt-display-mode-line (min-to-app)
  364.   "Add an appointment annotation to the mode line."
  365.   (setq appt-mode-line-string
  366.     (if (and appt-display-mode-line min-to-app)
  367.         (if (eq 0 min-to-app)
  368.         "App't NOW "
  369.         (concat "App't in " min-to-app
  370.             (if (eq 1 min-to-app) " minute  " " minutes ")))
  371.         ""))
  372.   ;; make sure our variable is visible in global-mode-string.
  373.   (cond ((not appt-display-mode-line) nil)
  374.     ((null global-mode-string)
  375.      (setq global-mode-string (list "" 'appt-mode-line-string)))
  376.     ((stringp global-mode-string)
  377.      (setq global-mode-string
  378.            (list global-mode-string 'appt-mode-line-string)))
  379.     ((not (memq 'appt-mode-line-string global-mode-string))
  380.      (setq global-mode-string
  381.            (append global-mode-string (list 'appt-mode-line-string)))))
  382.   ;; force mode line updates - from time.el
  383.   (save-excursion (set-buffer (other-buffer)))
  384.   (set-buffer-modified-p (buffer-modified-p))
  385.   (sit-for 0))
  386.  
  387.  
  388. ;;; Internal stuff
  389.  
  390. (defun appt-convert-time (time2conv)
  391.   "Convert hour:min[am/pm] format to minutes from midnight."
  392.   (cond ((string-match "^[ \t]*midni\\(ght\\|te\\)[ \t]*\\'" time2conv)
  393.      0)
  394.     ((string-match "^[ \t]*noon[ \t]*\\'" time2conv)
  395.      (* 12 60))
  396.     (t
  397.      (let ((hr 0)
  398.            (min 0))
  399.        (or (string-match
  400.          "\\`[ \t]*\\([0-9][0-9]?\\)[ \t]*\\(:[ \t]*\\([0-9][0-9]\\)\\)?[ \t]*\\(am\\|pm\\)?"
  401.          time2conv)
  402.            (error "unparsable time \"%s\"" time2conv))
  403.        (setq hr (string-to-int
  404.               (substring time2conv
  405.                  (match-beginning 1) (match-end 1))))
  406.        (if (match-beginning 3)
  407.            (setq min (string-to-int 
  408.                (substring time2conv 
  409.                       (match-beginning 3) (match-end 3)))))
  410.        ;; convert the time appointment time into 24 hour time
  411.        (if (match-beginning 4)
  412.            (progn
  413.          (if (or (= hr 0) (> hr 12))
  414.              (error "mixing 12hr and 24 hr time!  %s" time2conv))
  415.          (if (string-match "am"
  416.                    (substring time2conv (match-beginning 4)))
  417.              (if (= hr 12) (setq hr 0))
  418.            (if (< hr 12) (setq hr (+ 12 hr))))))
  419.        (if (> min 59) (error "minutes outa bounds - %s" time2conv))
  420.        (+ (* hr 60) min)))))
  421.  
  422.  
  423. (defun appt-current-time-in-minutes ()
  424.   "Returns the current time in minutes since midnight."
  425.   (let* ((str (current-time-string))
  426.      (hour (string-to-int (substring str 11 13)))
  427.      (min  (string-to-int (substring str 14 16))))
  428.     (+ (* hour 60) min)))
  429.  
  430.  
  431. (defun appt-sort-list (appt-list)
  432.   (sort (copy-sequence appt-list)
  433.     (function (lambda (x y)
  434.       (< (car (car x)) (car (car y)))))))
  435.  
  436. (defun appt-diary-entries ()
  437.   "Return an updated list of appointments for today."
  438.   (let ((list-diary-entries-hook '(appt-make-list))
  439.     (diary-display-hook 'ignore)
  440.     (diary-list-include-blanks nil))
  441.     ;; this will set appt-time-msg-list.
  442.     (diary 1)
  443.     appt-time-msg-list))
  444.  
  445. (defun appt-initialize ()
  446.   "Read your `diary-file' and remember today's appointments.  Call this from 
  447.  your .emacs file, or any time you want your .diary file re-read (this happens 
  448.  automatically at midnight to notice the next day's appointments).
  449.  
  450.  The time must be at the beginning of a line for it to be put in the 
  451.  appointments list.
  452.                02/23/89
  453.                   12:00pm    lunch
  454.                 Wednesday
  455.                   10:00am    group meeting"
  456.   (install-display-time-hook)
  457.   (let ((n (length (appt-diary-entries))))
  458.     (cond ((= n 0) (message "no appointments today."))
  459.       ((= n 1) (message "1 appointment today."))
  460.       (t (message "%d appointments today." n)))))
  461.  
  462. (defun appt-make-list ()
  463.   "Don't call this directly; call appt-initialize or appt-diary-entries."
  464.   (setq appt-time-msg-list nil)
  465.   (if diary-entries-list
  466.       ;; Cycle through the entry-list (diary-entries-list) looking for
  467.       ;; entries beginning with a time. If the entry begins with a time,
  468.       ;; add it to the appt-time-msg-list. Then sort the list.
  469.       ;;
  470.       (let ((entry-list diary-entries-list)
  471.         (new-appts '()))
  472.     (while (and entry-list
  473.             (calendar-date-equal
  474.               (calendar-current-date) (car (car entry-list))))
  475.       (let ((time-string (car (cdr (car entry-list)))))
  476.         (while (string-match
  477.             "\\`[ \t\n]*\\([0-9]?[0-9]\\(:[0-9][0-9]\\)?[ \t]*\\(am\\|pm\\)?\\|noon\\|midnight\\|midnite\\).*$"
  478.              time-string)
  479.           (let* ((eol (match-end 0))
  480.              (appt-time-string
  481.               (substring time-string (match-beginning 1)
  482.                  (match-end 1)))
  483.              (appt-msg-string
  484.               (substring time-string (match-end 1) eol))
  485.              (appt-time (list (appt-convert-time appt-time-string))))
  486.         (setq time-string (substring time-string eol)
  487.               new-appts (cons (cons appt-time
  488.                         (list (concat appt-time-string ":"
  489.                               appt-msg-string)))
  490.                       new-appts))))
  491.         (if appt-check-time-syntax
  492.         (while (string-match "\n*\\([^\n]+\\)$" time-string)
  493.           (beep)
  494.           (message "Unparsable time: %s"
  495.                (substring time-string (match-beginning 1)
  496.                       (match-end 1)))
  497.           (sit-for 3)
  498.           (setq time-string (substring time-string (match-end 0)))))
  499.                            
  500.         )
  501.       (setq entry-list (cdr entry-list)))
  502.     (setq appt-time-msg-list ; seems we can't nconc this list...
  503.           (append (nreverse new-appts) appt-time-msg-list))))
  504.   (setq appt-time-msg-list (appt-sort-list appt-time-msg-list))
  505.   ;;
  506.   ;; Get the current time and convert it to minutes from midnight, i.e.,
  507.   ;; 12:01am = 1, midnight = 0, so that the elements in the list that
  508.   ;; are earlier than the present time can be removed.
  509.   ;;
  510.   (let ((cur-comp-time (appt-current-time-in-minutes))
  511.     (appt-comp-time (car (car (car appt-time-msg-list)))))
  512.     (while (and appt-time-msg-list (< appt-comp-time cur-comp-time))
  513.       (setq appt-time-msg-list (cdr appt-time-msg-list)) 
  514.       (if appt-time-msg-list
  515.           (setq appt-comp-time (car (car (car appt-time-msg-list)))))))
  516.   appt-time-msg-list)
  517.  
  518.  
  519. (defun appt-beep (&optional final-p)
  520.   (cond ((null appt-audible) nil)
  521.     ((numberp appt-audible)
  522.      (let ((i appt-audible))
  523.        (while (> i 0) (beep) (setq i (1- i)))))
  524.     ((consp appt-audible)
  525.      (let ((i (car appt-audible))
  526.            (j (cdr appt-audible)))
  527.        (if (consp j) (setq j (car j)))
  528.        (while (> i 0)
  529.          (if (fboundp 'play-sound)
  530.          (beep nil (if final-p 'appt-final 'appt))
  531.            (beep))
  532.              (sleep-for j)
  533.          (setq i (1- i)))))
  534.     (t (beep))))
  535.  
  536.  
  537. (defun appt-check ()
  538.   "Check for an appointment and update the mode line and minibuffer if
  539.  desired. Note: the time must be the first thing in the line in the diary
  540.  for a warning to be issued.
  541.   The format of the time can be either 24 hour or am/pm.  Example: 
  542.  
  543.                02/23/89
  544.                  18:00 Dinner
  545.               Thursday
  546.                 11:45am Lunch meeting.
  547.   
  548.  The following variables control the action of the notification:
  549.  
  550.  appt-issue-message        If this variable is nil, then the code in this
  551.                 file does nothing.
  552.  appt-msg-countdown-list    Specifies how much warning you want before 
  553.                 appointments.
  554.  appt-audible            Whether to beep when it's notification-time.
  555.  appt-display-mode-line        Whether to display a countdown to the next 
  556.                 appointment in the mode-line.
  557.  appt-announce-method       The function used to do the notifications.
  558.                 'appt-window-announce to do it in a pop-up
  559.                 window, 'appt-message-announce or 
  560.                 'appt-persistent-message-announce to do it 
  561.                 in the echo-area.
  562.  appt-display-duration      If appt-announce-method is set to the function
  563.                 'appt-window-announce, this specifies how many
  564.                 seconds the pop-up window should stick around.
  565.  
  566.  This function is run from the `loadst' or `wakeup' process for display-time.
  567.  Therefore, you need to have (display-time) in your .emacs file."
  568.   (if appt-issue-message
  569.    (let ((min-to-app -1))
  570.      ;; Get the current time and convert it to minutes
  571.      ;; from midnight, i.e., 12:01am = 1, midnight = 0.
  572.      (let* ((cur-comp-time (appt-current-time-in-minutes))
  573.         ;; If the current time is the same as the tick, just return.
  574.         ;; This means that this function has been called more than once
  575.         ;; in the current minute, which is not useful.
  576.         (shut-up-this-time (= cur-comp-time appt-check-tick))
  577.         (turnover-p (> appt-check-tick cur-comp-time)))
  578.        (setq appt-check-tick cur-comp-time)
  579.        ;;
  580.        ;; If it is now the next day (we have crossed midnight since the last
  581.        ;; time this was called) then we should update our appointments to
  582.        ;; today's list.  Show the diary entries (tjc).
  583.        (if turnover-p (diary 1))
  584.        ;;
  585.        ;; Get the first time off of the list and calculate the number
  586.        ;; of minutes until the appointment.
  587.        (if appt-time-msg-list
  588.        (let ((appt-comp-time (car (car (car appt-time-msg-list)))))
  589.          (setq min-to-app (- appt-comp-time cur-comp-time))
  590.          (while (and appt-time-msg-list (< appt-comp-time cur-comp-time))
  591.            (setq appt-time-msg-list (cdr appt-time-msg-list)) 
  592.            (if appt-time-msg-list
  593.            (setq appt-comp-time (car (car (car appt-time-msg-list))))))
  594.          ;;
  595.          ;; If we have an appointment between midnight and warning-time
  596.          ;; minutes after midnight, we must begin to issue a message
  597.          ;; before midnight.  Midnight is considered 0 minutes and 11:59pm
  598.          ;; is 1439 minutes. Therefore we must recalculate the minutes to
  599.          ;; appointment variable. It is equal to the number of minutes
  600.          ;; before midnight plus the number of minutes after midnight our
  601.          ;; appointment is.
  602.          ;;
  603.          ;; ## I don't think this does anything -- it would if it were
  604.          ;; (for example) a 12:01am appt on the list at 11:55pm, but that
  605.          ;; can't ever happen, because the applicable 12:01am appt is for
  606.          ;; tomorrow, not today, and we only have today's diary list.
  607.          ;; It's not simply a matter of concatenating two days together,
  608.          ;; either, because then tuesday's appts would be signalled on
  609.          ;; monday.  We have to do a real one-day lookahead -- keep a list
  610.          ;; of tomorrow's appts, and check it when near midnight.
  611.          ;;
  612.          (if (and (< appt-comp-time (apply 'max appt-msg-countdown-list))
  613.               (> (+ cur-comp-time (apply 'max appt-msg-countdown-list))
  614.              max-time))
  615.          (setq min-to-app (+ (- (1+ max-time) cur-comp-time))
  616.                appt-comp-time))
  617.          ;;
  618.          ;; issue warning if the appointment time is within warning-time
  619.          (cond
  620.            ;; if there should not be any notifications in the mode-line,
  621.            ;; clear it.
  622.            ((> min-to-app (apply 'max appt-msg-countdown-list))
  623.         (appt-display-mode-line nil))
  624.            ;; do nothing if this is the second time this minute we've
  625.            ;; gotten here, of if we shouldn't be notifying right now.
  626.            ((or shut-up-this-time
  627.             (and (not (= min-to-app 0))
  628.              (not (memq min-to-app appt-msg-countdown-list))))
  629.         nil)
  630.  
  631.            ((and (= min-to-app 0)
  632.              (string-match "%%(" (nth 1 (car appt-time-msg-list))))
  633.         ;;
  634.         ;; If this is a magic evaluating-notification, evaluate it.
  635.         ;; these kinds of notifications aren't subject to the
  636.         ;; appt-msg-countdown-list.
  637.         ;;
  638.         (let* ((list-string (substring (nth 1 (car appt-time-msg-list))
  639.                            (1- (match-end 0))))
  640.                (form (condition-case ()
  641.                  (read list-string)
  642.                    (error
  643.                  (ding)
  644.                  (message "Appt: error reading from \"%s\""
  645.                       (nth 1 (car appt-time-msg-list)))
  646.                  (sit-for 2)
  647.                  nil))))
  648.           (eval form)))
  649.  
  650.            ((and (<= min-to-app (apply 'max appt-msg-countdown-list))
  651.              (>= min-to-app 0))
  652.         ;;
  653.         ;; produce a notification.
  654.         (appt-beep (= min-to-app 0))
  655.         (funcall appt-announce-method min-to-app
  656.              (car appt-time-msg-list))
  657.         ;; update mode line and expire if necessary
  658.         (appt-display-mode-line min-to-app)
  659.         ;; if it's expired, remove it.
  660.         (if (= min-to-app 0)
  661.             (setq appt-time-msg-list (cdr appt-time-msg-list))))
  662.            (t
  663.         ;; else we're not near any appointment, or there are no
  664.         ;; apointments; make sure mode line is clear.
  665.         (appt-display-mode-line nil))))
  666.        (appt-display-mode-line nil))))))
  667.  
  668.  
  669.  
  670. ;;; Interactively adding and deleting appointments
  671.  
  672. (defun appt-add (new-appt-time new-appt-msg)
  673.   "Adds an appointment to the list of appointments for the day at TIME
  674.  and issue MESSAGE. The time should be in either 24 hour format or
  675.  am/pm format. "
  676.  
  677.   (interactive "sTime (hh:mm[am/pm]): \nsMessage: ")
  678.   (if (string-match "[0-9]?[0-9]:[0-9][0-9]\\(am\\|pm\\)?" new-appt-time)
  679.       nil
  680.     (error "Unacceptable time-string"))
  681.   
  682.   (let* ((appt-time-string (concat new-appt-time " " new-appt-msg))
  683.          (appt-time (list (appt-convert-time new-appt-time)))
  684.          (time-msg (cons appt-time (list appt-time-string))))
  685.     (setq appt-time-msg-list (append appt-time-msg-list
  686.                                      (list time-msg)))
  687.     (setq appt-time-msg-list (appt-sort-list appt-time-msg-list)))) 
  688.  
  689. (defun appt-delete ()
  690.   "Deletes an appointment from the list of appointments."
  691.   (interactive)
  692.   (let* ((tmp-msg-list appt-time-msg-list))
  693.     (while tmp-msg-list
  694.       (let* ((element (car tmp-msg-list))
  695.              (prompt-string (concat "Delete " 
  696.                                     (prin1-to-string (car (cdr element))) 
  697.                                     " from list? "))
  698.              (test-input (y-or-n-p prompt-string)))
  699.         (setq tmp-msg-list (cdr tmp-msg-list))
  700.         (if test-input
  701.             (setq appt-time-msg-list (delq element appt-time-msg-list)))))
  702.     (message "")))
  703.  
  704.  
  705. ;;; Patching in to existing time code to install our hook.
  706.  
  707.  
  708. (defvar display-time-hook-installed nil)
  709.  
  710. (defun install-display-time-hook ()
  711.  (unless display-time-hook-installed    ; only do this stuff once!
  712.    (unless (boundp 'display-time-hook)    ; Need to wrapper it.
  713.      (defvar display-time-hook nil
  714.        "*List of functions to be called when the time is updated on the mode line.")
  715.      (let ((old-fn (if (or (featurep 'reportmail)
  716.                ;; old reportmail without a provide statement
  717.                (and (fboundp 'display-time-filter-18-55)
  718.                 (fboundp 'display-time-filter-18-57)))
  719.                (if (and (featurep 'itimer)  ; XEmacs reportmail.el
  720.                 (fboundp 'display-time-timer-function))
  721.                'display-time-timer-function
  722.              ;; older reportmail, or no timer.el.
  723.              (if (string-match "18\\.5[0-5]" (emacs-version))
  724.                  'display-time-filter-18-55
  725.                'display-time-filter-18-57))
  726.              ;; othewise, time.el
  727.              (if (and (featurep 'itimer)
  728.                   (fboundp 'display-time-function)) ; XEmacs
  729.              'display-time-function
  730.                'display-time-filter))))
  731.     ;; we're about to redefine it...
  732.        (fset 'old-display-time-filter (symbol-function old-fn))
  733.        (fset old-fn
  734.          (lambda (&rest args)  ;; ...here's the revised definition
  735.            "Revised version of the original function: this version calls a hook."
  736.            (apply 'old-display-time-filter args)
  737.            (run-hooks 'display-time-hook)))))
  738.    (setq display-time-hook-installed t)
  739.    (if (fboundp 'add-hook)
  740.        (add-hook 'display-time-hook 'appt-check)
  741.      (setq display-time-hook (cons appt-check display-time-hook)))
  742.    ))
  743.  
  744. (provide 'appt)
  745.